' pdm转为markdown形式的数据字典
' 将md更新到https://www.showdoc.cc的数据字典文档中
' 只会转当前model下当前选中的diagram

Option Explicit
ValidationMode = True
InteractiveMode = im_Batch

Dim BreakLine
' 换行符
BreakLine = chr(10)
' showdoc api地址
Private Const ShowDocUrl = "https://www.showdoc.cc/server/api/item/updateByApi"
' 修改为对应项目的ApiKey和ApiToken
Private Const ApiKey = "key"
Private Const ApiToken = "token"
' 一级目录名为model名称
' 二级目录名为diagram名称
Dim CatName, CatNameSub

Dim Model, Diagram
Set Model = ActiveModel
Set Diagram = ActiveDiagram

If (Model Is Nothing) Then
    output "There is no current Model!"
ElseIf Not Model.IsKindOf(PdPDM.cls_Model) Then
    output "The current model is not an Physical Data model!"
Else
	CatName = Model.Name
	CatNameSub = Diagram.Name
	' 解析每个数据模型
    ProcessFolder Diagram
End If

' 数据字典生成及更新到showdoc 
Private Sub ProcessFolder(folder)
	Dim Symbol
    Dim Tab 'running table 
    For Each Symbol In folder.Symbols
		If Symbol.ClassKind = cls_TableSymbol then
			Set Tab = Symbol.Object
			If Not Tab.isShortcut Then
				' 如果有表的注释,则不改变它.如果没有表注释.则把name添加到注释里面. 
				If Trim(Tab.comment) = "" Then
					Tab.comment = Tab.name
				End If
		   
				' 生成markdown
				Dim Markdown
				Markdown = GenerateMarkdown(Tab.Code, Tab.columns)
				' 更新到showdoc
				Dim RequestBody
				RequestBody = "api_key=" & ApiKey & "&api_token=" & ApiToken _
					& "&page_title=" + Tab.Name _
					& "&page_content=" + Markdown
				' 一级目录不为空 更新到一级目录
				If Trim(CatName) <> "" Then
					RequestBody = RequestBody & "&cat_name=" & CatName
				End If
				If Trim(CatNameSub) <> "" Then 
				    RequestBody = RequestBody & "&cat_name_sub=" & CatNameSub
				End If
				Dim ResponseBody
				ResponseBody = HTTPPost(ShowDocUrl, RequestBody)
			End If
		End If
    Next
End Sub

' http请求
Private Function HTTPPost(sUrl, sRequest)
	Dim HttpClient
	Set HttpClient = CreateObject("Microsoft.XMLHTTP")
	HttpClient.open "POST", sUrl, false
	HttpClient.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
	HttpClient.setRequestHeader "Content-Length", Len(sRequest)
	HttpClient.send sRequest
	HTTPPost = HttpClient.responseText
 End Function

' 通过表名、列生成markdown数据字典
Private Function GenerateMarkdown(TableCode, Columns)
	' markdown内容
	Dim Content
	Content = "`" & TableCode & "`" & BreakLine & BreakLine _
		& "|字段|类型|非空|默认值|注释|" & BreakLine _
		& "|:---|:---|:---|:---|:---|" & BreakLine
	Dim Col
	For Each Col In Columns
		' 如果col的comment为空,则填入name,如果已有注释,则不添加;这样可以避免已有注释丢失.
		If Trim(Col.Comment) = "" Then
			Col.Comment = Col.Name
		End If
		
		' 主键
		If Col.Primary Then
			Content = Content & "|**`" + Col.Code & "`**"
		Else
			Content = Content & "|" & Col.Code
		End If
		' 数据类型
		Content = Content & "|" & Col.DataType
		' 是否非空
		If lcase(Col.NullStatus) = "not null" Then
			Content = Content & "|是"
		Else
			Content = Content & "|否"
		End If
		' 默认值
		Content = Content & "| " & Col.DefaultValue
		' 注释
		' 替换掉注释中的换行 会导致markdown排版问题
		Dim Comment
		Comment = Replace(Col.Comment, chr(13), "")
		Comment = Replace(Comment, chr(10), "")
		Content = Content & " |" & Comment & "|"
		Content = Content & BreakLine
	Next
	
	GenerateMarkdown = Content + BreakLine + BreakLine
End Function